home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / sources.lha / sources / comp / assembler / m68is2.t < prev    next >
Text File  |  1988-02-05  |  16KB  |  426 lines
  1. (herald (assembler m68is2 t 0)
  2.         (env t (assembler as_open)))
  3.  
  4. ;;; Instructions
  5.  
  6. (define (m68/addx size src dst) (arith-x/d "addx" #xD (bwl size) src dst))
  7. (define (m68/subx size src dst) (arith-x/d "subx" #x9 (bwl size) src dst))
  8.  
  9.  
  10. (define (m68/addq size data dst) (aop-quick 0 (bwl size) data dst))
  11. (define (m68/addi size data dst) (op-immediate "add" #x06 (bwl size) data dst))
  12. (define (m68/add/ed size src dn) (op-into-dn "add" #xD (bwl size) src dn))
  13. (define (m68/add/de size dn dst) (op-into-ea "add" #xD (bwl size) dn dst))
  14. (define (m68/adda   size src an) (op-into-a "add" #xD (wl size) src an))
  15.  
  16. (define (m68/add size src dst)
  17.     (or (m68/addq   size src dst)
  18.         (m68/addi   size src dst)
  19.         (m68/add/ed size src dst)   
  20.         (m68/add/de size src dst)
  21.         (m68/adda   size src dst)
  22.         (error "no match for (add ~s ~g ~g)" size src dst)))
  23.  
  24. (define (m68/subq size data dst) (aop-quick 1 (bwl size) data dst))
  25. (define (m68/subi size data dst) (op-immediate "sub" #x04 (bwl size) data dst))
  26. (define (m68/sub/ed size src dn) (op-into-dn "sub" #x9 (bwl size) src dn))
  27. (define (m68/sub/de size dn dst) (op-into-ea "sub" #x9 (bwl size) dn dst))
  28. (define (m68/suba   size src an) (op-into-a "sub" #x9 (wl size) src an))
  29.  
  30. (define (m68/sub size src dst)
  31.     (or (m68/subq   size src dst)
  32.         (m68/subi   size src dst)
  33.         (m68/sub/ed size src dst)   
  34.         (m68/sub/de size src dst)
  35.         (m68/suba   size src dst)
  36.         (error "no match for (sub ~s ~g ~g)" size src dst)))
  37.  
  38. (define (m68/cmpi size data dst) (op-immediate "cmp" #x0C (bwl size) data dst))
  39. (define (m68/cmp/ed size src dn) (op-into-dn "cmp" #xB (bwl size) src dn))
  40. (define (m68/cmpa   size src an) (op-into-a "cmp" #xB (wl size) src an))
  41.  
  42. (define (m68/cmp size src dst)
  43.     (or (m68/cmp/ed size src dst)   
  44.         (m68/cmpa   size src dst)
  45.         (m68/cmpi   size src dst)
  46.         (error "no match for (cmp ~s ~g ~g)" size src dst)))
  47.  
  48. (define-fg (m68/cmpm-1 bwl (ar+-number? ax) (ar+-number? ay))
  49.     (printer "cmpm.~c a~s+,a~s+" (format-bwl (? bwl)) (? ax) (? ay))
  50.     (f u 4 #xB) (f u 3 ax) (1) (f u 2 bwl) (0 0 1) (f u 3 ay))
  51.  
  52. (define (m68/cmpm size src dst)
  53.     (or (m68/cmpm-1 (bwl size) src dst)
  54.         (error "no match for (cmpm ~s ~g ~g)" size src dst)))
  55.  
  56. (define (m68/andi size data dst) (op-immediate "and" #x02 (bwl size) data dst))
  57. (define (m68/and/ed size src dn) (op-into-dn "and" #xC (bwl size) (ea-d&a? src) dn))
  58. (define (m68/and/de size dn dst) (op-into-ea "and" #xC (bwl size) dn dst))
  59.  
  60. (define (m68/and size src dst)
  61.     (or (m68/and/ed size src dst)   
  62.         (m68/and/de size src dst)   
  63.         (m68/andi   size src dst)
  64.         (error "no match for (and ~s ~g ~g)" size src dst)))
  65.  
  66. (define (m68/ori  size data dst) (op-immediate "or"  #x00 (bwl size) data dst))
  67. (define (m68/or/ed size src dn) (op-into-dn "or" #x8 (bwl size) (ea-d? src) dn))
  68. (define (m68/or/de size dn dst) (op-into-ea "or" #x8 (bwl size) dn dst))
  69.  
  70. (define (m68/or size src dst)
  71.     (or (m68/or/ed size src dst)   
  72.         (m68/or/de size src dst)
  73.         (m68/ori   size src dst)
  74.         (error "no match for (or ~s ~g ~g)" size src dst)))
  75.  
  76. (define (m68/eori size data dst) (op-immediate "eor" #x0A (bwl size) data dst))
  77. (define (m68/eor/de size dn dst) (op-into-ea-1 "eor" #xB (bwl size) dn dst))
  78.  
  79. (define (m68/eor size src dst)
  80.     (or (m68/eor/de size src dst)   
  81.         (m68/eori   size src dst)
  82.         (error "no match for (eor ~s ~g ~g)" size src dst)))
  83.         
  84. (define (m68/asl/dd size dx   dy) (shift-op/dd #b00 1 (bwl size) dx dy))
  85. (define (m68/asr/dd size dx   dy) (shift-op/dd #b00 0 (bwl size) dx dy))
  86. (define (m68/asl/id size data dy) (shift-op/id #b00 1 (bwl size) data dy))
  87. (define (m68/asr/id size data dy) (shift-op/id #b00 0 (bwl size) data dy))
  88. (define (m68/asl/e  dst)     (shift-op/e  #b00 1  dst))
  89. (define (m68/asr/e  dst)     (shift-op/e  #b00 0  dst))
  90.  
  91. (define (m68/asl size src dst) (shift-op #b00 1 size src dst))
  92. (define (m68/asr size src dst) (shift-op #b00 0 size src dst))
  93.  
  94. (define (m68/lsl/dd size dx   dy) (shift-op/dd #b01 1 (bwl size) dx dy))
  95. (define (m68/lsr/dd size dx   dy) (shift-op/dd #b01 0 (bwl size) dx dy))
  96. (define (m68/lsl/id size data dy) (shift-op/id #b01 1 (bwl size) data dy))
  97. (define (m68/lsr/id size data dy) (shift-op/id #b01 0 (bwl size) data dy))
  98. (define (m68/lsl/e  dst)     (shift-op/e  #b01 1 dst))
  99. (define (m68/lsr/e  dst)     (shift-op/e  #b01 0 dst))
  100.  
  101. (define (m68/lsl size src dst) (shift-op #b01 1 size src dst))
  102. (define (m68/lsr size src dst) (shift-op #b01 0 size src dst))
  103.  
  104. (define (m68/rol/dd size dx   dy) (shift-op/dd #b11 1 (bwl size) dx dy))
  105. (define (m68/ror/dd size dx   dy) (shift-op/dd #b11 0 (bwl size) dx dy))
  106. (define (m68/rol/id size data dy) (shift-op/id #b11 1 (bwl size) data dy))
  107. (define (m68/ror/id size data dy) (shift-op/id #b11 0 (bwl size) data dy))
  108. (define (m68/rol/e  dst)     (shift-op/e  #b11 1 dst))
  109. (define (m68/ror/e  dst)     (shift-op/e  #b11 0 dst))
  110.  
  111. (define (m68/rol size src dst) (shift-op #b11 1 size src dst))
  112. (define (m68/ror size src dst) (shift-op #b11 0 size src dst))
  113.  
  114. (define (m68/roxl/dd size dx   dy) (shift-op/dd #b10 1 (bwl size) dx dy))
  115. (define (m68/roxr/dd size dx   dy) (shift-op/dd #b10 0 (bwl size) dx dy))
  116. (define (m68/roxl/id size data dy) (shift-op/id #b10 1 (bwl size) data dy))
  117. (define (m68/roxr/id size data dy) (shift-op/id #b10 0 (bwl size) data dy))
  118. (define (m68/roxl/e  dst)     (shift-op/e  #b10 1 dst))
  119. (define (m68/roxr/e  dst)     (shift-op/e  #b10 0 dst))
  120.  
  121. (define (m68/roxl size src dst) (shift-op #b10 1 size src dst))
  122. (define (m68/roxr size src dst) (shift-op #b10 0 size src dst))
  123.  
  124. (define (shift-op op dir size src dst)
  125.     (or (shift-op/dd op dir (bwl size) src dst)   
  126.         (shift-op/id op dir (bwl size) src dst)
  127.         (error "no match for (~a~c ~s ~g ~g)" 
  128.                (format-shift op)
  129.                (format-dir dir)
  130.                size src dst)))
  131.  
  132. (define (m68/bchg/de dn dst) (bit-op/de #b01 dn dst))
  133. (define (m68/bclr/de dn dst) (bit-op/de #b10 dn dst))
  134. (define (m68/bset/de dn dst) (bit-op/de #b11 dn dst))
  135. (define (m68/btst/de dn dst) (bit-op/de #b00 dn dst))
  136.  
  137. (define (m68/bchg/ie data dst) (bit-op/ie #b01 data dst))
  138. (define (m68/bclr/ie data dst) (bit-op/ie #b10 data dst))
  139. (define (m68/bset/ie data dst) (bit-op/ie #b11 data dst))
  140. (define (m68/btst/ie data dst) (bit-op/ie #b00 data dst))
  141.  
  142. (define (m68/bchg src dst) (bit-op #b01 src dst))
  143. (define (m68/bclr src dst) (bit-op #b10 src dst))
  144. (define (m68/bset src dst) (bit-op #b11 src dst))
  145. (define (m68/btst src dst) (bit-op #b00 src dst))
  146.  
  147. (define (bit-op op src dst)
  148.     (or (bit-op/de op src dst)
  149.         (bit-op/ie op src dst)
  150.         (error "no match for (~a ~g ~g)" (format-bit-op op) src dst)))
  151.  
  152. (define (m68/divs src dn) (op-reg-ea.w "divs" #x8 7 src dn))
  153. (define (m68/divu src dn) (op-reg-ea.w "divu" #x8 3 src dn))
  154. (define (m68/muls src dn) (op-reg-ea.w "muls" #xC 7 src dn))
  155. (define (m68/mulu src dn) (op-reg-ea.w "mulu" #xC 3 src dn))
  156. (define (m68/chk  src dn) (op-reg-ea.w "chk"  #x4 6 src dn))
  157.  
  158. (define (m68/clr  size dst) (op-size-ea "clr"  #x42 (bwl size) dst))
  159. (define (m68/neg  size dst) (op-size-ea "neg"  #x44 (bwl size) dst))
  160. (define (m68/negx size dst) (op-size-ea "negx" #x40 (bwl size) dst))
  161. (define (m68/not  size dst) (op-size-ea "not"  #x46 (bwl size) dst))
  162. (define (m68/tst  size dst) (op-size-ea "tst"  #x4A (bwl size) dst))
  163.  
  164. (define-fg (m68/nop)   (printer "nop")   (f u 16 #x4E71))
  165. (define-fg (m68/rtr)   (printer "rtr")   (f u 16 #x4E77))
  166. (define-fg (m68/rts)   (printer "rts")   (f u 16 #x4E75))
  167. (define-fg (m68/trapv) (printer "trapv") (f u 16 #x4E76))
  168. ;(define-fg (m68/rte)   (printer "rte")   (f u 16 #x4E73))
  169. ;(define-fg (m68/reset) (printer "reset") (f u 16 #x4E70))
  170. ;(define-fg (m68/stop i)  (printer "stop #~s" (? i)) (f u 16 #x4E72) (f s 16 i))
  171.  
  172. ;;; Apparently formatless instructions
  173.  
  174. (define-fg (m68/moveq (&-moveq-byte? data) (dr-number? dn))
  175.     (printer "moveq #~s,d~s" (? data) (? dn))
  176.     (f u 4 #x7) (f u 3 dn) (0) (f s 8 data))
  177.  
  178. (define (m68/move size src dst) 
  179.     (cond ((and (eq? size 'l) (m68/moveq src dst))
  180.            => identity)
  181.           (else
  182.            (or (m68/move-fg (blw size) src dst)
  183.                (m68/movea-fg (lw size) src dst)
  184.                (error "no match for (move ~s ~g ~g)" size src dst)))))
  185.  
  186. (define-fg (m68/move-fg blw (ea-all? src) (ea-d&a? dst))
  187.     (printer "move.~c  ~g,~g" (format-blw (? blw)) (? xsrc) 
  188.                              (if (pair? (? dst)) (car (? dst)) (? dst)))
  189.     (local xsrc)
  190.     (0 0) (f u 2 blw)
  191.     (f u 6 (reverse-ea-bits (? dst)))
  192.     (fg-named xsrc (ea-fg (? src) (context-blw (? blw))))
  193.     (fg (if (pair? (? dst)) (cdr (? dst)) null-fg)))
  194.  
  195. (define-fg (m68/movea-fg lw (ea-all? src) (ar-number? dst))
  196.     (printer "movea.~c ~g,a~s" (format-lw (? lw)) (? xsrc) (? dst))
  197.     (local xsrc)
  198.     (0 0 1) (f u 1 lw)
  199.     (f u 3 dst) (0 0 1)
  200.     (fg-named xsrc (ea-fg (? src) (context-lw (? lw)))))
  201.  
  202. (define (reverse-ea-bits ea)
  203.    (let ((fg (if (pair? ea) (car ea) ea)))
  204.      (receive (v1 w1 start2)
  205.               (destructure-fg fg 0)
  206.         (receive (v2 w2 #f)
  207.                  (destructure-fg fg start2)
  208.            (cond ((and (fx= w1 3) (fx= w2 3))
  209.                   (fx+ (fixnum-ashl v2 3) v1))
  210.                  (else 
  211.                   (error "expecting an effective address, got ~s" ea)))))))
  212.  
  213. (define (m68/movem size src dst)
  214.     (or (m68/movem/re (wl size) src dst)
  215.         (m68/movem/er (wl size) src dst)
  216.         (error "no match for (movem ~a ~g ~g)" size src dst)))
  217.  
  218. (define-fg (eal-fg ext context)
  219.   (fg ext context))
  220.  
  221. (define-fg (m68/movem/re wl rl (ea-c&a-or-decr? ea))
  222.     (printer "movem.~c ~s,~g" (format-wl (? wl)) (? rl) (? ea))
  223.     (0 1 0 0  1 0 0 0  1) (f u 1 wl)
  224.     (fg (if (pair? (? ea)) (car (? ea)) (? ea)))
  225.     (f u 16 (convert-register-list (? rl) (@-a? (? ea))))
  226.     (fg (if (pair? (? ea)) (eal-fg (cdr (? ea)) '(general 32)) null-fg)))
  227.  
  228. (define-fg (m68/movem/er wl (ea-c&-or-incr? ea) rl)
  229.     (printer "movem.~c ~g,~s" (format-wl (? wl)) (? ea) (? rl))
  230.     (0 1 0 0  1 1 0 0  1) (f u 1 wl) 
  231.     (fg (if (pair? (? ea)) (car (? ea)) (? ea)))
  232.     (f u 16 (convert-register-list (? rl) nil))
  233.     (fg (if (pair? (? ea)) (eal-fg (cdr (? ea)) '(general 32)) null-fg)))
  234.  
  235.  
  236.  
  237.                             
  238. (define-constant *forward-regs* 
  239.                  '(d0 d1 d2 d3 d4 d5 d6 d7 a0 a1 a2 a3 a4 a5 a6 a7)) 
  240.  
  241. (define-constant *backward-regs*
  242.                  '(a7 a6 a5 a4 a3 a2 a1 a0 d7 d6 d5 d4 d3 d2 d1 d0)) 
  243.  
  244. (define (convert-register-list rl d0-first?)
  245.     (iterate loop ((regs (if d0-first? *forward-regs* *backward-regs*))
  246.                    (rl rl)
  247.                    (bits 0))
  248.        (cond ((null? regs) bits)
  249.              ((memq? (car regs) rl)
  250.               (loop (cdr regs) rl (fx+ (fixnum-ashl bits 1) 1)))
  251.              (else
  252.               (loop (cdr regs) rl (fixnum-ashl bits 1))))))
  253.  
  254. (define-fg (m68/dbcc (convert-cc cc) (dr-number? dn) tag)
  255.     (printer "db~a d~s,~g" (format-cc (? cc)) (? dn) (? tag))
  256.     (local here)
  257.     (f u 4 5) (f u 4 cc) (1 1 0 0 1) (f u 3 dn) 
  258.     (mark here)
  259.     (f s 16 (fixnum-ashr (from here tag) 3)))
  260.  
  261. (define-fg (m68/exgd (dr-number? dx) (dr-number? dy))
  262.     (printer "exg d~s,d~s" (? dx) (? dy))
  263.     (f u 4 #xC) (f u 3 dx) (1 0 1 0 0 0) (f u 3 dy))
  264.  
  265. (define-fg (m68/exga (ar-number? ax) (ar-number? ay))
  266.     (printer "exg a~s,a~s" (? ax) (? ay))
  267.     (f u 4 #xC) (f u 3 ax) (1 0 1 0 0 1) (f u 3 ay))
  268.  
  269. (define-fg (m68/exgad (ar-number? ax) (dr-number? dy))
  270.     (printer "exg a~s,d~s" (? ax) (? dy))
  271.     (f u 4 #xC) (f u 3 dy) (1 1 0 0 0 1) (f u 3 ax))
  272.  
  273. (define-fg (m68/exgda (dr-number? dx) (ar-number? ay))
  274.     (printer "exg d~s,a~s" (? dx) (? ay))
  275.     (f u 4 #xC) (f u 3 dx) (1 1 0 0 0 1) (f u 3 ay))
  276.                 
  277. (define (m68/exg src dst)
  278.     (or (m68/exga  src dst)
  279.         (m68/exgd  src dst)
  280.         (m68/exgad src dst)
  281.         (m68/exgda src dst)
  282.         (error "no match for (exg ~g ~g)" src dst)))
  283.      
  284. (define (m68/ext size dn)
  285.     (or (m68/ext-1 size dn) 
  286.         (error "no match for (ext ~s ~g)" size dn)))
  287.  
  288. (define-fg (m68/ext-1 size (dr-number? dn))
  289.     (printer "ext.~c d~s" (if (eq? (? size) 'w) #\w #\l) (? dn))
  290.     (0 1 0 0  1 0 0 0  1) (f u 1 (if (eq? (? size) 'w) 0 1)) (0 0 0) (f u 3 dn))
  291.  
  292. (define-fg (m68/jmp ea)
  293.     (printer "jmp ~g" (? subfg))
  294.     (local subfg)
  295.     (0 1 0 0  1 1 1 0  1 1) (fg-named subfg (ea-fg (? ea) nil)))
  296.  
  297. (define-fg (m68/jsr ea)
  298.     (printer "jsr ~g" (? subfg))
  299.     (local subfg)
  300.     (0 1 0 0  1 1 1 0  1 0) (fg-named subfg (ea-fg (? ea) nil)))
  301.  
  302. (define (m68/lea ea an)
  303.     (or (m68/lea-1 ea an)
  304.         (error "no match for (lea ~g ~g)" ea an)))
  305.  
  306. (define-fg (m68/lea-1 (ea-c? ea) (ar-number? an))
  307.     (printer "lea ~g,a~s" (? subfg) (? an))
  308.     (local subfg)
  309.     (f u 4 4) (f u 3 an) (1 1 1) (fg-named subfg (ea-fg (? ea) nil)))
  310.  
  311. (define-fg (m68/link (ar-number? an) (&-word? frame-size))
  312.     (printer "link a~s,#~s" (? an) (? frame-size))
  313.     (0 1 0 0  1 1 1 0  0 1 0 1  0) (f u 3 an) (f s 16 frame-size))
  314.                      
  315. (define (m68/pea ea)
  316.     (or (m68/pea-1 ea)
  317.         (error "no match for (pea ~g)" ea)))
  318.  
  319. (define-fg (m68/pea-1 (ea-c? ea))
  320.     (printer "pea ~g" (? subfg))
  321.     (local subfg)
  322.     (0 1 0 0  1 0 0 0  0 1) (fg-named subfg (ea-fg (? ea) nil)))
  323.  
  324. (define-fg (m68/scc (convert-cc cc) (ea-d&a? ea))
  325.     (printer "s~a.b ~g" (format-cc (? cc)) (? subfg))
  326.     (local subfg)
  327.     (f u 4 5) (f u 4 cc) (1 1) (fg-named subfg (ea-fg (? ea) nil)))
  328.  
  329. (define-fg (m68/swap (dr-number? dn))
  330.     (printer "swap d~s" (? dn))
  331.     (0 1 0 0  1 0 0 0   0 1 0 0  0) (f u 3 dn))
  332.  
  333. (define-fg (m68/tas (ea-d&a? ea))
  334.     (printer "tas ~g" (? subfg))
  335.     (local subfg)
  336.     (0 1 0 0  1 0 1 0  1 1) (fg-named subfg (ea-fg (? ea) nil)))
  337.  
  338. (define-fg (m68/trap v)
  339.     (printer "trap #~s" (? v))
  340.     (f u 12 #x4E4) (f u 4 v))
  341.  
  342. (define-fg (m68/unlk (ar-number? an))
  343.     (printer "unlk a~s" (? an))
  344.     (f u 12 #x4E5) (1) (f u 3 an))
  345.  
  346. ;;; unimplemented:
  347. ;;;   abcd, nbcd, sbcd
  348. ;;;   move-to-ccr, move-to-sr, move-from-sr, move-to-usp, move-from-usp
  349. ;;;   movep
  350.  
  351. ;;; Exports
  352.  
  353. (define (initialize-m68-lap-env)
  354.   (walk (lambda (item) 
  355.            (*define-lap-m68 (car item) (*value orbit-env (cdr item))))
  356.      '(
  357.        (add        . m68/add)
  358.        (addx       . m68/addx)
  359.        (sub        . m68/sub)
  360.        (subx       . m68/subx)
  361.        (cmp        . m68/cmp)
  362.        (cmpm       . m68/cmpm)
  363.        (and        . m68/and)
  364.        (or         . m68/or)
  365.        (eor        . m68/eor)
  366.        (asl/e      . m68/asl/e)
  367.        (asr/e      . m68/asr/e)
  368.        (asl        . m68/asl)
  369.        (asr        . m68/asr)
  370.        (lsl/e      . m68/lsl/e)
  371.        (lsr/e      . m68/lsr/e)
  372.        (lsl        . m68/lsl)
  373.        (lsr        . m68/lsr)
  374.        (rol/e      . m68/rol/e)
  375.        (ror/e      . m68/ror/e)
  376.        (rol        . m68/rol)
  377.        (ror        . m68/ror)
  378.        (roxl/e     . m68/roxl/e)
  379.        (roxr/e     . m68/roxr/e)
  380.        (roxl       . m68/roxl)
  381.        (roxr       . m68/roxr)
  382.        (bchg       . m68/bchg)
  383.        (bclr       . m68/bclr)
  384.        (bset       . m68/bset)
  385.        (btst       . m68/btst)
  386.        (divs       . m68/divs)
  387.        (divu       . m68/divu)
  388.        (muls       . m68/muls)
  389.        (mulu       . m68/mulu)
  390.        (chk        . m68/chk)
  391.        (clr        . m68/clr)
  392.        (neg        . m68/neg)
  393.        (negx       . m68/negx)
  394.        (not        . m68/not)
  395.        (tst        . m68/tst)
  396.        (nop        . m68/nop)
  397.        (rtr        . m68/rtr)
  398.        (rts        . m68/rts)
  399.        (trapv      . m68/trapv)
  400. ;       (rte        . m68/rte)
  401. ;       (reset      . m68/reset)
  402. ;       (stop       . m68/stop)
  403.        (moveq      . m68/moveq)
  404.        (move       . m68/move)
  405.        (movem      . m68/movem)
  406.        (dbcc       . m68/dbcc)
  407.        (exg        . m68/exg)
  408.        (ext        . m68/ext)
  409.        (jmp        . m68/jmp)
  410.        (jsr        . m68/jsr)
  411.        (lea        . m68/lea)
  412.        (link       . m68/link)
  413.        (pea        . m68/pea)
  414.        (scc        . m68/scc)
  415.        (swap       . m68/swap)
  416.        (tas        . m68/tas)
  417.        (trap       . m68/trap)
  418.        (unlk       . m68/unlk)
  419.        (jbcc       . m68/jbcc)
  420.        (jbra       . m68/jbra)
  421.        (jbsr       . m68/jbsr)
  422.        )))
  423.  
  424. (initialize-m68-lap-env)
  425.  
  426.